home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / ActiveX Controlls / XP Suite / DATA1.CAB / XP_Panel_Sample_Files / CICON.cls < prev    next >
Encoding:
Visual Basic class definition  |  2003-04-24  |  2.1 KB  |  54 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CICON"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Const MAX_PATH = 260
  17. Private Const SHGFI_DISPLAYNAME = &H200
  18. Private Const SHGFI_EXETYPE = &H2000
  19. Private Const SHGFI_SYSICONINDEX = &H4000  'system icon index
  20. Private Const SHGFI_LARGEICON = &H0  'large icon
  21. Private Const SHGFI_SMALLICON = &H1  'small icon
  22. Private Const SHGFI_SHELLICONSIZE = &H4
  23. Private Const SHGFI_TYPENAME = &H400
  24. Private Const ILD_TRANSPARENT = &H1  'display transparent
  25. Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
  26. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
  27. Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hDCDest As Long, ByVal x As Long, ByVal y As Long, ByVal flags As Long) As Long
  28. Private Type SHFILEINFO
  29.    hIcon As Long
  30.    iIcon As Long
  31.    dwAttributes As Long
  32.    szDisplayName As String * MAX_PATH
  33.    szTypeName As String * 80
  34. End Type
  35. Private shinfo As SHFILEINFO
  36.  
  37. Public Function ExtractIconToHDC(hdc As Long, fNAME As String) As Boolean
  38.  On Error GoTo ErrorExtractIconToHDC
  39.  Dim hImgSmall As Long   'the handle to the system image list
  40. 'get the system icon associated with that file
  41.  hImgSmall& = SHGetFileInfo(fNAME, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
  42.  'draw the associated icon into the picturebox
  43. Call ImageList_Draw(hImgSmall&, shinfo.iIcon, hdc, 0, 0, ILD_TRANSPARENT)
  44.  Exit Function
  45.  
  46. ErrorExtractIconToHDC:
  47. MsgBox Err & ":Error in ExtractIconToHDC.  Error Message: " & Err.Description, vbCritical, "Warning"
  48. Exit Function
  49. End Function
  50.  
  51.  
  52.  
  53.  
  54.